{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit DirectShowEnumerator;

interface

uses Classes, DirectShow9, DSUtil;


type
  TAHMDirectShowEnumerator = class
  private
    FSysEnumerator: TSysDevEnum;
    FFilterMapper: IFilterMapper2;
  protected
    function EnumerateFilters(MediaTypes: array of TGUID; Names: TStrings): Boolean;
    function CreateFilter(MediaTypes: array of TGUID; Name: String): IBaseFilter;
  public
    constructor Create;
    destructor Destroy; override;
    function EnumerateAudioCaptureSources(Names: TStrings): Boolean;
    function EnumerateAudioRenderers(Names: TStrings): Boolean;
    function EnumerateDVDVideoFilters(Names: TStrings): Boolean;
    function EnumerateDVDAudioFilters(Names: TStrings): Boolean;
    function CreateAudioCaptureSource(Name: String): IBaseFilter;
    function CreateDefaultRadioSource(var Name: String): IBaseFilter;
    function CreateAudioRenderer(Name: String): IBaseFilter;
    function CreateDVDVideoFilter(Name: String): IBaseFilter;
    function CreateDVDAudioFilter(Name: String): IBaseFilter;
    function HasDVDVideoProperties(Name: String): Boolean;
    function HasDVDAudioProperties(Name: String): Boolean;
    procedure ShowDVDVideoProperties(Handle: Cardinal; Name: String);
    procedure ShowDVDAudioProperties(Handle: Cardinal; Name: String);
  end;


implementation

uses Windows, ActiveX, SysUtils, DirectShowHelper, Logging;

constructor TAHMDirectShowEnumerator.Create;
var
  hr: HRESULT;
begin
  inherited Create;

  // Enumerator for system devices
  FSysEnumerator := TSysDevEnum.Create;

  // Enumerator for DirectShow filters
  hr := CoCreateInstance(CLSID_FilterMapper2, nil, CLSCTX_INPROC, IID_IFilterMapper2, FFilterMapper);
  if hr <> S_OK then
  begin
    LogWarn('Failed to create DirectShow Filter Mapper instance: ' + DSGetErrorString9(hr));
    FFilterMapper := nil;
  end;
end;

destructor TAHMDirectShowEnumerator.Destroy;
begin
  FSysEnumerator.Free;
  FFilterMapper := nil;

  inherited Destroy;
end;

function TAHMDirectShowEnumerator.EnumerateAudioCaptureSources(Names: TStrings): Boolean;
var
  i: Integer;
begin
  Result := False;
  if not Assigned(Names) then Exit;

  // We'll work with audio input device category (audio capture devices)
  FSysEnumerator.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);

  for i := 0 to Pred(FSysEnumerator.CountFilters) do
    Names.Add(FSysEnumerator.Filters[i].FriendlyName);

  Result := True;
end;

function TAHMDirectShowEnumerator.EnumerateAudioRenderers(Names: TStrings): Boolean;
var
  i: Integer;
begin
  Result := False;
  if not Assigned(Names) then Exit;

  // We'll work with audio renderer category (sound card devices)
  FSysEnumerator.SelectGUIDCategory(CLSID_AudioRendererCategory);

  for i := 0 to Pred(FSysEnumerator.CountFilters) do
    Names.Add(FSysEnumerator.Filters[i].FriendlyName);

  Result := True;
end;

function TAHMDirectShowEnumerator.EnumerateFilters(MediaTypes: array of TGUID; Names: TStrings): Boolean;
var
  hr: HRESULT;
  Fetched: ULONG;
  Enumerator: IEnumMoniker;
  Moniker: IMoniker;
  PropertyBag: IPropertyBag;
  Name: OleVariant;
begin
  Result := False;

  if (FFilterMapper <> nil) and Assigned(Names) then
  begin
    hr := FFilterMapper.EnumMatchingFilters(Enumerator, 0, True, MERIT_UNLIKELY,
                                            True, Length(MediaTypes) div 2,
                                            @MediaTypes[0], nil, nil, False,
                                            True, 0, nil, nil, nil);

    if (hr <> S_OK) or (Enumerator = nil) then
    begin
      LogWarn('Failed to enumerate matching DirectShow Filters: ' + DSGetErrorString9(hr));
      Exit;
    end;

    // Iterate through our enumerator...
    while Enumerator.Next(1, Moniker, @Fetched) = S_OK do
    begin
      // Map filter properties into a property bag
      hr := Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropertyBag);
      if hr = S_OK then
      begin
        // Extract filter friendly name to add to our list
        hr := PropertyBag.Read('FriendlyName', Name, nil);
        if hr = S_OK then Names.Add(Name);
      end;

      // Release moniker and property bag for next iteration
      PropertyBag := nil;
      Moniker := nil;
    end;

    Result := True;
  end;
end;

function TAHMDirectShowEnumerator.EnumerateDVDVideoFilters(Names: TStrings): Boolean;
var
  MediaTypes: array of TGUID;
begin
  // Populate required media types for filters
  SetLength(MediaTypes, 2);
  MediaTypes[0] := MEDIATYPE_Video;
  MediaTypes[1] := MEDIASUBTYPE_MPEG2_VIDEO;

  // Call generic method to enumerate suitable filters
  Result := EnumerateFilters(MediaTypes, Names);
end;

function TAHMDirectShowEnumerator.EnumerateDVDAudioFilters(Names: TStrings): Boolean;
var
  MediaTypes: array of TGUID;
begin
  // Populate required media types for filters
  SetLength(MediaTypes, 2);
  MediaTypes[0] := MEDIATYPE_Audio;
  MediaTypes[1] := MEDIASUBTYPE_MPEG2_AUDIO;

  // Call generic method to enumerate suitable filters
  Result := EnumerateFilters(MediaTypes, Names);
end;

function TAHMDirectShowEnumerator.CreateAudioCaptureSource(Name: String): IBaseFilter;
var
  i: Integer;
begin
  Result := nil;

  // We'll work with audio input device category (audio capture devices)
  FSysEnumerator.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);

  // Iterate through available renderers to match name
  for i := 0 to Pred(FSysEnumerator.CountFilters) do
    if Name = FSysEnumerator.Filters[i].FriendlyName then
    begin
      // Create instance of appropriate filter
      Result := FSysEnumerator.GetBaseFilter(i);
      Break;
    end;
end;

function TAHMDirectShowEnumerator.CreateDefaultRadioSource(var Name: String): IBaseFilter;

var
  i: Integer;
begin
  Result := nil;

  // We'll work with audio input device category (audio capture devices)
  FSysEnumerator.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);

  // Iterate through available renderers to match name containing 'radio'
  for i := 0 to Pred(FSysEnumerator.CountFilters) do
    if Pos('radio', LowerCase(FSysEnumerator.Filters[i].FriendlyName)) > 0 then
    begin
      // Create instance of appropriate filter
      Result := FSysEnumerator.GetBaseFilter(i);
      Name := FSysEnumerator.Filters[i].FriendlyName;
      Break;
    end;
end;

function TAHMDirectShowEnumerator.CreateAudioRenderer(Name: String): IBaseFilter;
var
  i: Integer;
begin
  Result := nil;

  // We'll work with audio renderer category (sound card devices)
  FSysEnumerator.SelectGUIDCategory(CLSID_AudioRendererCategory);

  // Iterate through available renderers to match name
  for i := 0 to Pred(FSysEnumerator.CountFilters) do
    if Name = FSysEnumerator.Filters[i].FriendlyName then
    begin
      // Create instance of appropriate filter
      Result := FSysEnumerator.GetBaseFilter(i);
      Break;
    end;
end;

function TAHMDirectShowEnumerator.CreateFilter(MediaTypes: array of TGUID; Name: String): IBaseFilter;
var
  hr: HRESULT;
  Fetched: ULONG;
  Enumerator: IEnumMoniker;
  Moniker: IMoniker;
  PropertyBag: IPropertyBag;
  FoundName: OleVariant;
begin
  Result := nil;

  if (FFilterMapper <> nil) and (Name <> '') then
  begin
    hr := FFilterMapper.EnumMatchingFilters(Enumerator, 0, True, MERIT_UNLIKELY,
                                            True, Length(MediaTypes) div 2,
                                            @MediaTypes[0], nil, nil, False,
                                            True, 0, nil, nil, nil);

    if (hr <> S_OK) or (Enumerator = nil) then
    begin
      LogWarn('Failed to enumerate matching DirectShow Filters: ' + DSGetErrorString9(hr));
      Exit;
    end;

    // Iterate through our enumerator...
    while Enumerator.Next(1, Moniker, @Fetched) = S_OK do
    begin
      // Map filter properties into a property bag
      hr := Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropertyBag);
      if hr = S_OK then
      begin
        // Does filter friendly name match what we're looking for?
        hr := PropertyBag.Read('FriendlyName', FoundName, nil);
        if (hr = S_OK) and (FoundName = Name) then
        begin
          try
            // Bind the moniker to a filter instance (which creates it)
            hr := Moniker.BindToObject(nil, nil, IID_IBaseFilter, Result);
            if hr <> S_OK then
            begin
              LogWarn('Failed to instantiate filter instance for ' + Name + ': ' + DSGetErrorString9(hr));
              Result := nil;
            end;
          except
            LogError('Exception raised while trying to instantiate filter instance for ' + Name);
            Result := nil;
          end;

          Exit;
        end;
      end;
          
      // Release moniker and property bag for next iteration
      PropertyBag := nil;
      Moniker := nil;
    end;
  end;
end;

function TAHMDirectShowEnumerator.CreateDVDVideoFilter(Name: String): IBaseFilter;
var
  MediaTypes: array of TGUID;
begin
  // Populate required media types for filters
  SetLength(MediaTypes, 2);
  MediaTypes[0] := MEDIATYPE_Video;
  MediaTypes[1] := MEDIASUBTYPE_MPEG2_VIDEO;

  // Call generic function to create filter instance
  Result := CreateFilter(MediaTypes, Name);
end;

function TAHMDirectShowEnumerator.CreateDVDAudioFilter(Name: String): IBaseFilter;
var
  MediaTypes: array of TGUID;
begin
  // Populate required media types for filters
  SetLength(MediaTypes, 2);
  MediaTypes[0] := MEDIATYPE_Audio;
  MediaTypes[1] := MEDIASUBTYPE_MPEG2_AUDIO;

  // Call generic function to create filter instance
  Result := CreateFilter(MediaTypes, Name);
end;

function TAHMDirectShowEnumerator.HasDVDVideoProperties(Name: String): Boolean;
var
  Filter: IBaseFilter;
begin
  // Create instance of filter
  Filter := CreateDVDVideoFilter(Name);
  Result := (Filter <> nil) and HaveFilterPropertyPage(Filter);
end;

function TAHMDirectShowEnumerator.HasDVDAudioProperties(Name: String): Boolean;
var
  Filter: IBaseFilter;
begin
  // Create instance of filter
  Filter := CreateDVDAudioFilter(Name);
  Result := (Filter <> nil) and HaveFilterPropertyPage(Filter);
end;

procedure TAHMDirectShowEnumerator.ShowDVDVideoProperties(Handle: Cardinal; Name: String);
var
  Filter: IBaseFilter;
begin
  // Create instance of filter
  Filter := CreateDVDVideoFilter(Name);
  if Filter <> nil then ShowFilterPropertyPage(Handle, Filter);
end;

procedure TAHMDirectShowEnumerator.ShowDVDAudioProperties(Handle: Cardinal; Name: String);
var
  Filter: IBaseFilter;
begin
  // Create instance of filter
  Filter := CreateDVDAudioFilter(Name);
  if Filter <> nil then ShowFilterPropertyPage(Handle, Filter);
end;


end.
